Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/Libraries/NewFader 2.0/NewFader.p

Text File | 1997-04-16 | 5KB | 176 lines

{----------------------------------------------------------------------}
{The Gamma Fading history :}
{}
{On 12/17/92 ,Matt Slot ,[e-mail], wrote a C program for performing}
{gamma fading on the Macintosh.}
{}
{Matt last updated that program 6/29/95 to release v1.1.3.}
{}
{On 7/20/93, Matthew Xavier Mora, [e-mail], made a library using the }
{Gamma C code, and wrote a Think Pascal program which sampled the use of that library }
{(including some pascal routines for delaying the fade).}
{}
{In a separate endeavor in 1994, Ingemar Ragnemalm also created a library based upon the }
{C code, added some separate fade in and fade out routines in Pascal, and got a pascal }
{program running the gamma fader in Think Pascal. In July of 95 he updated his project}
{to use Matt's v1.1.3 gamma routines, and added a CW project as well.}
{}
{Happy with having an available gamma fader, us Pascal programmers were still not quite }
{_satisfied_ being that the library was still C-coded.}
{}
{So on 7/13/95, Matthew Mora ported the entire C-code over to Pascal, and got it }
{debugged and running on 7/18/95 in Think Pascal.}
{}
{Ecstatic over the whole thing, on 7/18/95, Bill Catambay created CW projects in }
{68K and PPC demonstrating the Gamma Fading using _pure_ pascal (incorporating }
{Matthew's ported library routines, his older delay routines, tuning for CW, and }
{cleaning the code a bit).}
{}
{07/23/95: Changes by Ingemar R:}
{• Added a Think Pascal lib and added the necessary conditional compilation switches to make it run in both worlds.}
{• Cleaned up the capitalization a bit (to conform with Inside Mac).}
{• Centered the window on the screen.}
{• Modified the picture: now 2k instead of 80k, and easier to edit in the future.}
{I made NO changes in the fading unit except the IFC in the uses clause.}
{}
{05/08/96: Updates by Ingemar R:}
{• CW7 projects. (Not CW8, but at least better than CW5 or 6.)}
{• Changed PBControl and PBStatus to PBControlSync and PBStatusSync.}
{}
{Files in project:}
{}
{NewFader.p  -  This test program for performing a slow fade out, a fast fade in, and}
{                then a fast fade out and a slow fade in.}
{GammaPaslib.p  -  The gamma routines and internal type declarations, all in PASCAL.}
{NewFader.µ.rsrc  -  Resource for About picture.}
{NewFader(68K).µ  -  The 68K CW project for the gamma fading program.}
{NewFader(PPC).µ  -  The PPC CW project for the gamma fading program.}
{NewFader.π - Think Pascal project (added by Ingemar)}
{}
{Works like a charm!}
{}
{Bill Catambay, [e-mail]}
{----------------------------------------------------------------------}
program DoubleFade;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        ToolUtils, Fonts, SegLoad, Dialogs, Processes, Types, Windows, Quickdraw, OSUtils,
        Menus, TextEdit, Memory, Events,
{$ENDC}
        GammaPaslib;

    var
        oe: integer;
        delayTime: Longint;
        myRect, bounds: Rect;
        myWindow: WindowPtr;
        myPicture: PicHandle;

    procedure DelayFadeToBlack (delayTicks: Longint);

        var
            i: integer;
            oe: integer;
            finalTicks: Longint;

    begin
        i := 100;
        while i > 0 do
            begin
                oe := DoGammaFade(i);
                i := i - 1;
                Delay(delayTicks, finalTicks);
            end;
    end; {DelayFadeToBlack}

    procedure FadeToBlack (speed: integer);

        var
            i: integer;
            oe: integer;

    begin
        i := 100;
        while (i >= 0) do
            begin
                oe := DoGammaFade(i);
                i := i - speed;
            end;
    end; {FadeToBlack}

    procedure FadeFromBlack (speed: integer);

        var
            i: integer;
            oe: integer;

    begin
        i := 0;
        while (i <= 100) do
            begin
                oe := DoGammaFade(i);
                i := i + speed;
            end;
    end; {FadeFromBlack}

    procedure DelayFadeFromBlack (delayTicks: Longint);

        var
            i: integer;
            oe: integer;
            finalTicks: Longint;

    begin
        i := 0;
        while (i <= 100) do
            begin
                oe := DoGammaFade(i);
                i := i + 1;
                Delay(delayTicks, finalTicks);
            end;
    end; {DelayFadeFromBlack}

    procedure ToolboxInit;

    begin
{$IFC UNDEFINED THINK_PASCAL}
        InitGraf(@qd.thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEinit;
        InitDialogs(nil);
{$ENDC}
        MaxApplZone;
        InitCursor;
    end; {ToolboxInit}

begin {Main program}
    ToolboxInit;
    delayTime := 1;
    if not isGammaAvailable then
        ExitToShell;
    oe := SetupGammaTools;
{Center the picture's bounds on the screen}
{$IFC UNDEFINED THINK_PASCAL}
    bounds := qd.screenBits.bounds;
{$ELSEC}
    bounds := screenBits.bounds;
{$ENDC}
    myPicture := GetPicture(128);
    myRect := myPicture^^.picFrame;
    OffsetRect(myRect, (bounds.right - bounds.left - myRect.right - myRect.left) div 2, (bounds.bottom - bounds.top - myRect.bottom - myRect.top) div 2);
{Fade and then create the window}
    DelayFadeToBlack(delaytime);
    myWindow := NewCWindow(nil, myRect, '', TRUE, plainDBox, Pointer(-1), FALSE, 0);
    SetPort(myWindow);
    DrawPicture(myPicture, myWindow^.portRect);
    FadeFromBlack(2);
    repeat
    until Button;
    FadeToBlack(2);
    HideWindow(mywindow);
    DelayFadeFromBlack(delaytime);
    oe := DisposeGammaTools;
end.